Loading libraries

library(shadowtext)
library(DescTools)
library(tidyverse)
library(lubridate)
library(ggthemes)
library(broom)
library(wrapr)
library(rgdal)
library(waffle)

Setting plot theme

extrafont::loadfonts(device = 'win')

roz_cz <- 12
roz_cz_txt <- roz_cz / 3.597
leg_sq <- .8

theme_set(
  theme_minimal(base_family = 'Calibri') +
  theme(
    panel.grid = element_blank(),
    text = element_text(size = roz_cz),
    axis.title.x = element_blank(),
    axis.title.y = element_blank(),
    legend.position = 'top',
    legend.direction = 'horizontal',
    legend.title = element_blank()
  )
)

colors <- c(
  rgb(66, 85, 136, maxColorValue = 255),
  rgb(171, 177, 203, maxColorValue = 255),
  rgb(0, 112, 192, maxColorValue = 255),
  rgb(0, 160, 157, maxColorValue = 255),
  rgb(102, 81, 161, maxColorValue = 255),
  rgb(137, 173, 209, maxColorValue = 255),
  rgb(162, 148, 201, maxColorValue = 255),
  rgb(40, 50, 90, maxColorValue = 255),
  rgb(82, 104, 165, maxColorValue = 255),
  rgb(0, 115, 124, maxColorValue = 255),
  rgb(170, 22, 82, maxColorValue = 255),
  rgb(8, 99, 146, maxColorValue = 255),
  rgb(29, 111, 184, maxColorValue = 255),
  rgb(3, 156, 188, maxColorValue = 255),
  rgb(96, 195, 226, maxColorValue = 255)
)

fmt <- function(x, n = 0) {
  x %>%
    round(n) %>%
    format(big.mark = " ", decimal.mark = ',', trim = TRUE)
}

fmt2 <- function(x, n = 1) {
  (x / 1e6) %>%
    round(n) %>%
    format(decimal.mark = ",", big.mark = ' ', trim = TRUE)
}

Loading the data

data_list <- list()

for (i in dir('data/')) {
  data_list[[str_remove(i, '\\..*$')]] <- read_csv2(paste0('data/', i))
}

Stacked barplot with totals

data_list$plot1 %>%
  gather(type, n, 2:4) %>%
  ggplot(aes(
    x = year,
    y = n,
    fill = type,
    label = n %>% fmt()
  )) +
  geom_col(col = 'white') +
  geom_text(
    position = position_stack(.5),
    family = 'Calibri',
    size = roz_cz_txt,
    color = 'white'
  ) +
  geom_label(aes(
    y = total + max(total) * .06,
    label = total %>% fmt()),
    family = 'Calibri',
    size = roz_cz_txt,
    fill = 'white',
    color = colors[1],
    label.padding = unit(0.1, 'lines'),
    show.legend = FALSE
  ) +
  geom_label(aes(
    x = 2015.78,
    y = 500,
    label = '    '
  ),
  size = 2.5,
  fill = 'white',
  color = colors[1],
  label.padding = unit(0.1, 'lines')
  ) +
  geom_text(aes(
    x = 2015.88,
    y = 500,
    label = 'total'
  ),
  family = 'Calibri',
  size = roz_cz_txt,
  hjust = 0,
  check_overlap = TRUE
  ) +
  guides(fill = guide_legend(
    keyheight = .8,
    keywidth = .8
  )) +
  scale_fill_manual(values = colors[c(4, 3, 8)]) +
  theme(
    axis.text.y = element_blank(),
    legend.spacing.x = unit(1, 'mm'),
    legend.position = c(.45, .956),
    plot.margin = margin(40, 5, 5, 5)
  )

Dodged barplot with percentages

data_list$plot2 %>%
  filter(year == 2017) %>% 
  select(-1) %>%
  gather(woj, n, -type) %>%
  spread(type, n) %>%
  mutate(wsp = accepted / submitted) %>%
  gather(type, n, c(accepted, submitted)) %>%
  mutate(
    wsp_pos = wsp * max(n) + max(n) * 1.2,
    wsp_lab = wsp_pos * 1.07,         
    txt_pos = n + max(n) * .008
  ) %>%
  ggplot(
    data = .,
    aes(
      x = woj %>% fct_rev(),
      y = n,
      fill = type,
      label = n %>% fmt()
  )) +
  geom_segment(aes(
      xend = woj %>% fct_rev(),
      y = 0,
      yend = wsp_pos
    ),
    linetype = 'dotted',
    col = colors[4],
    alpha = .7
  ) +
  geom_col(
    position = position_dodge(.9),
    col = 'white'
  ) +
  geom_text(
    aes(y = n + 10),
    position = position_dodge(.9),
    family = 'Calibri',
    size = roz_cz_txt - .4,
    hjust = 0
  ) +
  geom_point(aes(
      y = wsp_pos,
      shape = 'success rate'
    ),
    fill = colors[4],
    size = 6,
    stroke = .1,
    color = 'white'
  ) +
  geom_text(aes(
      y = wsp_pos,
      label = (wsp * 100) %>% round()
    ),
    family = 'Calibri',
    color = 'white',
    size = roz_cz_txt,
    show.legend = FALSE
  ) +
  geom_text(aes(
      y = wsp_pos,
      label = '%'
    ),
    family = 'Calibri',
    nudge_y = 170,
    color = colors[4],
    size = roz_cz_txt,
    show.legend = FALSE
  ) +
  coord_flip() +
  scale_fill_manual(values = colors[1:2]) +
  scale_shape_manual(values = 21) +
  guides(fill = guide_legend(
    keyheight = leg_sq,
    keywidth = leg_sq,
    reverse = TRUE,
    order = -1)
  ) +
  theme(
    axis.text.x = element_blank(),
    plot.margin = margin(t = 60),
    legend.position = c(.412, 1.09),
    legend.direction = 'horizontal',
    legend.box = 'horizontal',
    legend.spacing.x = unit(1, 'mm'),
    legend.box.just = 'left',
    legend.margin = margin(0, 0, 0, 0)
  )

Lollipop plot with totals

data_list$plot3 %>%
  mutate(total = rowSums(.[2:6])) %>%
  gather(type, n, -c(year, total)) %>%
  mutate(
    type = type %>% reorder(n),
    year_pos = -max(n) * .1
  ) %.>%
  ggplot(
    data = .,
    aes(
      x = year,
      y = n)
  ) +
  geom_line(
    data = select(., year, n) %>%
      transmute(
        y = max(n) * 1.02,
        x1 = year - .4,
        x2 = year + .4
      ) %>%
      unique() %>%
      mutate(gr = row_number()) %>%
      gather('i', 'x', x1:x2),
    aes(
      x = x,
      y = y,
      group = gr
    ),
    color = colors[1]
  ) +
  geom_curve(data = tibble(
      x = c(unique(.$year) + .4, unique(.$year) - .45),
      x2 = c(unique(.$year) + .45, unique(.$year) - .4),
      y = rep(c(max(.$n) * 1.02, max(.$n) * 1.01), each = 5),
      y2 = rep(c(max(.$n) * 1.01, max(.$n) * 1.02), each =  5),
      gr = 1:10
    ),
    aes(
      x = x,
      xend = x2,
      y = y,
      yend = y2,
      group = gr
    ),
    color = colors[1],
    curvature = .5
  ) +
  geom_col(
    aes(fill = type),
    position = position_dodge(.8),
    width = .1
  ) +
  geom_line(data = tibble(
      x = c(unique(.$year) - .45, unique(.$year) + .45),
      y = 0,
      gr = rep(1:5, 2)
    ),
    aes(
      x = x,
      y = y,
      group = gr
    ),
    color = colors[1]
  ) +
  geom_point(
    aes(color = type),
    position = position_dodge(.8),
    size = 2
  ) +
  geom_point(
    aes(y = year_pos),
    size = 15,
    color = colors[1],
    show.legend = FALSE
  ) +
  geom_text(aes(
      y = year_pos,
      label = year
    ),
    check_overlap = TRUE,
    color = 'white',
    family = 'Calibri'
  ) +
  geom_text(aes(
      y = max(.$n) * 1.05,
      label = total %>% fmt()
    ),
    check_overlap = TRUE,
    color = colors[1],
    hjust = 0,
    size = roz_cz_txt,
    family = 'Calibri'
  ) +
  geom_label(aes(
      y = n / 2,
      group = type,
      label = n %>% fmt()
    ),
    position = position_dodge(.8),
    family = 'Calibri',
    fill = 'white',
    color = colors[1],
    label.size = .2,
    size = roz_cz_txt - .5,
    label.padding = unit(0.1, 'lines'),
    show.legend = FALSE
  ) +
  coord_flip() +
  guides(color = guide_legend(
      override.aes = list(size = 3),
      keyheight = leg_sq,
      keywidth = leg_sq,
      reverse = TRUE
    ),
    fill = FALSE
  ) +
  scale_fill_manual(values = colors[c(1, 4, 8, 7, 3)]) +
  scale_color_manual(values = colors[c(1, 4, 8, 7, 3)]) +
  theme(
    legend.spacing.x = unit(1, 'mm'),
    axis.text = element_blank(),
    legend.position = c(.5, 1.01),
    plot.margin = margin(t = 15),
    legend.direction = 'horizontal'
  ) +
  ylim(c(.$year_pos[1] * 1.1, max(.$n) * 1.12))

Point-line percentage plot

data_list$plot4 %>%
  gather('typ', 'wsp', -year) %>%
  mutate(
    wsp = as.numeric(wsp),
    xpos = case_when(
      typ == 'group 4' &
        year %in% c(2012:2014, 2015, 2017) ~ year - .15,
      typ == 'group 1' &
        year %in% c(2012, 2014) ~ year + .15,
      typ == 'group 5' &
        year == 2013 ~ year + .15,
      typ == 'group 5' &
        year == 2017 ~ year + .28,
      typ == 'group 2' &
        year == 2015 ~ year + .15,
      TRUE ~ year
  )) %.>%
  ggplot(
    data = .,
    aes(
      x = xpos,
      y = wsp,
      color = typ,
      fill = typ,
      label = (wsp * 100) %>% round()
  )) +
  geom_line(
    data = tibble(
      x = c(unique(.$year)[-1] - .5) %>% rep(2),
      y = min(.$wsp)
    ) %>%
      mutate(
        y = c(min(y), Inf) %>% rep(each = length(x) / 2),
        gr = 1:(length(x) / 2) %>% rep(2)
      ),
    aes(
      x = x,
      y = y,
      group = gr
    ),
    color = colors[1],
    alpha = .3,
    linetype = 'dotted',
    lwd = .2,
    inherit.aes = FALSE
  ) +
  geom_line(
    lwd = .5,
    alpha = .5
  ) +
  geom_point(
    size = 5,
    shape = 21,
    stroke = 0,
    color = 'white'
  ) +
  geom_text(
    family = 'Calibri',
    color = 'white',
    size = roz_cz_txt - .4
  ) +
  geom_shadowtext(aes(
      label = '%',
      x = xpos + .15
    ),
    family = 'Calibri',
    size = roz_cz_txt - .4,
    bg.color = 'white'
  ) +
  scale_x_continuous(breaks = unique(.$year)) +
  scale_color_manual(values = colors[c(2, 4, 8, 7, 3)] %>% rev()) +
  scale_fill_manual(values = colors[c(2, 4, 8, 7, 3)] %>% rev()) +
  theme(
    axis.text.y = element_blank(),
    legend.position = c(.5, 1.02),
    plot.margin = margin(20, 1, 1, 1),
    legend.spacing.x = unit(1, 'mm'),
    legend.direction = 'horizontal'
  )

Dodged barplot with counts and percentages

data_list$plot5 %>%
  mutate(
    kategoria = kategoria %>% factor(levels = paste('category', c('A+', 'A', 'B', 'C'))),
    wsp_pos = wsp * max(val) * 1.5 - max(val) * .8,
    wsp_lab = wsp_pos - max(val) * .1,
    txt_pos = if_else(
      typ == 'mean number of accepted submissions per unit' &
        kategoria == 'kategoria C',
      val + max(val) * .07,
      val + max(val) * .05
    ),
    typ2 = if_else(
      typ == 'mean number of accepted submissions per unit',
      'number of units',
      'x')
    ) %>% 
  ggplot(aes(
    x = kategoria,
    y = val,
    fill = typ %>% fct_rev(),
    label = (val * 1e6) %>% fmt2()
  )) +
  geom_col(
    position = 'dodge',
    col = 'white'
  ) +
  geom_line(aes(
      y = wsp_pos,
      group = 1
    ),
    linetype = 'dotted',
    color = colors[4],
    lwd = .4
  ) +
  geom_point(aes(
      y = val / 2,
      col = typ2 %>% fct_rev()
    ),
    position = position_dodge(.9),
    shape = 21,
    fill = 'white',
    size = 6.5
  ) +
  geom_text(aes(
      y = val / 2,
      label = n
    ),
    position = position_dodge(.9),
    family = 'Calibri',
    size = roz_cz_txt - .6
  ) +
  geom_point(aes(
      y = wsp_pos,
      shape = 'success rate'
    ),
    size = 6,
    stroke = 0,
    fill = colors[4],
    color = 'white'
  ) +
  geom_text(
    aes(y = txt_pos),
    position = position_dodge(.9),
    family = 'Calibri',
    size = roz_cz_txt
  ) +
  geom_text(aes(
      y = wsp_pos,
      label = (wsp * 100) %>%
        round()
    ),
    family = 'Calibri',
    size = roz_cz_txt,
    color = 'white'
  ) +
  geom_shadowtext(aes(
      y = wsp_pos,
      label = '%'
    ),
    size = roz_cz_txt,
    family = 'Calibri',
    nudge_x = .13,
    color = colors[4],
    bg.color = 'white'
  ) +
  scale_fill_manual(values = colors[c(6, 8)]) +
  scale_color_manual(
    breaks = 'number of units',
    values = colors[c(6, 8)]
  ) +
  guides(
    color = guide_legend(
      override.aes = list(size = 3.3),
      label.position = 'left'
    ),
    fill = guide_legend(
      label.position = 'left',
      reverse = TRUE
    ),
    shape = guide_legend(
      override.aes = list(size = 4),
      label.position = 'left')
  ) +
  scale_shape_manual(values = 21) +
  theme(
    axis.text.y = element_blank(),
    legend.margin = margin(0, 0, 0, 0),
    legend.spacing.y = unit(0, 'mm'),
    legend.direction = 'vertical',
    legend.box = 'vertical',
    axis.text.x = element_text(vjust = 48),
    legend.key.size = unit(leg_sq, 'lines'),
    legend.box.just = 'right',
    legend.position = c(.67, .85)
  )

Facet dodged barplot with percentages

legend <-
  tibble(
    obsz = c(rep("2", 12), rep("1", 6)),
    rok = rep("2018", 18),
    zl = c(rep(1, 6), rep(2, 6), rep(3, 6)),
    fin = rep(1:6, 3),
    wsp = c(rep(1, 6), rep(2, 6), rep(1, 6)),
    lab_pos = c(rep(-50, 6), rep(1750, 6), rep(950, 6)),
    wsp_pos = c(
      seq(-500, -100, length.out = 6),
      seq(1300, 1700, length.out = 6),
      seq(500, 900, length.out = 6)
    ),
    rok_pos = rep(NA, 18),
    wsp_lab = c(
      rep("number of accepted projects", 6),
      rep("number of submitted projects", 6),
      rep("% success rate", 6)
    ))

data_list$plot6a %>% 
  gather(rok, val, -obsz) %>%
  left_join(
    data_list$plot6b %>%
      gather(rok, val, -obsz),
    by = c('obsz', 'rok')
  ) %>%
  rename_at(3:4, ~ c('zl', 'fin')) %>%
  mutate(
    wsp = fin / zl,
    lab_pos = zl - max(zl) * .03,
    wsp_pos = wsp * 2e3 + max(zl) * .92,
    rok_pos = -max(wsp_pos) * .25,
    wsp_lab = (wsp * 100) %>% round() %>% as.character(),
    obsz = obsz %>%
      factor(levels = c(
        '1',
        '2',
        'group 1',
        'group 2',
        'group 3',
        'group 4',
        'group 5',
        'group 6',
        'group 7'
      ) %>% rev()
    ),
    rok = rok %>% factor(levels = 2012:2018)) %>%
  ggplot(aes(
    x = obsz,
    y = zl,
    fill = rok,
    color = rok,
    label = zl)
  ) +
  geom_segment(aes(
      xend = obsz,
      y = zl,
      yend = wsp_pos
    ),
    linetype = 3,
    alpha = .5
  ) +
  geom_col(
    position = position_dodge(.9),
    alpha = .6,
    col = 'white'
  ) +
  geom_col(aes(
      y = fin,
      color = NULL
    ),
    width = .7
  ) +
  geom_text(aes(
      y = fin / 2,
      label = fin
    ),
    color = 'white',
    size = roz_cz_txt - 1
  ) +
  geom_point(
    aes(y = wsp_pos),
    shape = 21,
    size = 4.4,
    color = 'white'
  ) +
  geom_text(aes(
      y = wsp_pos,
      label = wsp_lab
    ),
    color = 'white',
    size = roz_cz_txt - .8,
    family = 'Calibri'
  ) +
  geom_point(aes(
      x = 'group 4',
      y = rok_pos
    ),
    size = 14
  ) +
  geom_text(aes(
      x = 'group 4',
      y = rok_pos,
      label = rok
    ),
    family = 'Calibri',
    color = 'white',
    size = 4.5,
    check_overlap = TRUE
  ) +
  geom_label(
    aes(y = lab_pos),
    family = 'Calibri',
    color = colors[1],
    fill = 'white',
    label.r = unit(0, 'lines'),
    label.padding = unit(0.1, 'lines'),
    label.size = .2,
    size = roz_cz_txt - .8
  ) +
  geom_text(aes(
      y = -70,
      label = obsz
    ),
    size = roz_cz_txt,
    color = rgb(59, 58, 60, maxColorValue = 255),
    hjust = 1,
    family = 'Calibri',
    check_overlap = TRUE
  ) +
  geom_text(aes(
      y = wsp_pos + max(wsp_pos) * .02,
      label = '%'
    ),
    family = 'Calibri',
    hjust = 0,
    size = roz_cz_txt - .3
  ) +
  geom_point(
    data = legend,
    aes(
      y = wsp_pos,
      shape = factor(zl),
      color = factor(fin),
      alpha = factor(wsp)
    ),
    size = 2.2
  ) +
  geom_text(
    data = legend,
    aes(
      y = lab_pos,
      label = wsp_lab
    ),
    family = 'Calibri',
    size = roz_cz_txt - .5,
    color = rgb(59, 58, 60, maxColorValue = 255),
    check_overlap = TRUE,
    hjust = 0
  ) +
  coord_flip() +
  facet_grid(
    rok %>% fct_rev() ~ .,
    scales = 'free',
    space = 'free'
  ) +
  scale_shape_manual(values = c(15, 15, 16)) +
  scale_alpha_manual(values = c(1, .6)) +
  scale_fill_manual(values = colors[c(4, 3, 7, 8, 6, 9, 4, 3, 5, 8, 9, 7)] %>% rev()) +
  scale_color_manual(values = colors[c(7, 8, 6, 9, 4, 3, 5, 8, 9, 7, 4, 3)] %>% rev()) +
  theme(
    legend.position = 'none',
    axis.text = element_blank(),
    strip.text = element_blank()
  )

Bubble map

woj <-
  readOGR("maps/województwa.shp", "województwa") %>%
  spTransform(CRS("+init=epsg:4326"))
## OGR data source with driver: ESRI Shapefile 
## Source: "D:\wd\my_ggplots\maps\województwa.shp", layer: "województwa"
## with 16 features
## It has 29 fields
woj_naz <-
  coordinates(woj) %>%
  as_tibble() %>%
  set_names(c("long", "lat")) %>%
  mutate(
    województwo = woj@data$jpt_nazwa_,
    id = as.character(0:15)
  )

woj_df <-
  tidy(woj) %>%
  left_join(
    woj_naz %>%
      select(id, województwo)
  )

spc <- .15

dane_art <-
  data_list$map1 %>%
  group_by(typ) %>%
  summarise_at(2:17, sum) %>% 
  gather(wjw, n, -typ) %>%
  filter(!typ %like% 'Articl.*') %>%
  group_by(wjw) %>%
  mutate(sum = sum(n)) %>%
  left_join(woj_naz, c('wjw' = 'województwo')) %>%
  group_by(wjw) %>%
  mutate(
    typ = typ %>% fct_relevel('Article', after = Inf),
    lat = case_when(
      wjw == 'pomorskie' ~ lat + .11,
      wjw == 'wielkopolskie' ~ lat - .12,
      wjw == 'kujawsko-pomorskie' ~ lat + .05,
      wjw == 'opolskie' ~ lat + .07,
      wjw == 'dolnoslaskie' ~ lat + .07,
      TRUE ~ lat
    ),
    long = case_when(
      wjw == 'zachodniopomorskie' ~ long - .2,
      wjw == 'warminsko-mazurskie' ~ long - .2,
      wjw == 'kujawsko-pomorskie' ~ long - .4,
      wjw == 'swietokrzyskie' ~ long - .09,
      wjw == 'slaskie' ~ long - .07,
      TRUE ~ long
    ),
    lat_p = case_when(
      typ == 'Arti' ~ lat + spc / .8,
      typ == 'Book' ~ lat - spc / .8,
      TRUE ~ lat
    ) %>% `-`(.2)
  )

woj_df %>%
  ggplot(aes(
    x = long,
    y = lat,
    group = group
  )) +
  geom_polygon(
    fill = 'white',
    col = colors[2] %>% alpha(.6),
    size = .2
  ) +
  geom_point(
    data = dane_art,
    aes(
      x = long - .2,
      y = lat_p + .05,
      size = n,
      color = typ,
      group = NULL
    ),
    alpha = .6
  ) +
  geom_text(
    data = dane_art,
    aes(
      y = lat_p + .05,
      label = n %>% fmt(),
      group = NULL
    ),
    family = 'Calibri',
    size = 2.5,
    hjust = 0,
    color = rgb(.2, .2, .2)
  ) +
  geom_text(
    data = dane_art,
    aes(
      x = long - .3,
      y = lat + .22,
      label = wjw,
      group = NULL
    ),
    family = 'Calibri',
    size = 2.5,
    hjust = 0,
    color = rgb(.2, .2, .2),
    check_overlap = TRUE
  ) +
  scale_size_area(trans = 'sqrt', max_size = 4.5) +
  scale_color_manual(
    values = colors[c(3, 5, 4)],
    labels = c(
      'category 1',
      'category 2',
      'category 3'
  )) +
  guides(
    size = FALSE,
    color = guide_legend(override.aes = list(
      size = 4,
      color = colors[3:5]
  ))) +
  theme_map() +
  theme(
    legend.title = element_blank(),
    legend.position = c(.1, .05),
    legend.background = element_rect(color = 'transparent', fill = 'transparent')
  )

Waffle map

woj_sum <-
  woj_naz %>%
  left_join(data_list$map2)

n_row <- 6

main <-
  woj_df %>%
  ggplot(aes(
    x = long,
    y = lat,
    group = group
  )) +
  geom_polygon(
    fill = 'white',
    col = colors[2],
    size = .2
  ) +
  geom_text(
    data = woj_sum,
    aes(label = województwo, group = NULL),
    nudge_y = .14,
    size = roz_cz_txt - .4,
    family = 'Calibri'
  ) +
  geom_text(
    data = woj_sum,
    aes(label = total, group = NULL),
    nudge_y = .29,
    size = roz_cz_txt,
    family = 'Calibri'
  ) +
  theme_void() +
  xlim(c(13.8, 24.2))

subplot <-
  woj_sum %>%
  mutate(mar = total / n_row) %>%
  select(-c(województwo, total, id)) %>%
  pmap(function(
    `group 1`,
    `group 2`,
    `group 3`,
    long,
    lat,
    mar
    ) {
    annotation_custom(
      ggplotGrob(
        waffle(
          c(`group 1`,
            `group 2`,
            `group 3`),
          legend_pos = 'none',          
          size = .3,
          rows = n_row,
          colors = colors[c(9, 6, 4)]
        )
      ),
      xmin = long - mar,
      xmax = long + mar,
      ymin = lat - .28 - .13,
      ymax = lat + .28 - .13)
  })

main + subplot +
  annotation_custom(
    ggplotGrob(
      waffle(
        c(`1 unit of type 1` = 0,
          `1 unit of type 2` = 0,
          `1 unit of type 3` = 1),
        legend_pos = 'bottom',
        colors = colors[c(9, 6, 4)]) +
        theme(legend.text = element_text(
          family = 'Calibri',
          size = roz_cz - .5
        )) +
        guides(fill = guide_legend(
          keywidth = leg_sq,
          keyheight = leg_sq
        ))),
    ymin = 54.7
  )

Difference plot

data_list$plot7 %>%
  slice(-1) %>%
  mutate(
    województwo = reorder(województwo, received),
    clr = received > lost,
    poz_pos = if_else(
      received > lost,
      received + 1e3,
      received - 1e3
    ),
    utr_pos = if_else(
      received < lost,
      lost + 1e3,
      lost - 1e3)
  ) %>%
  gather(poz_utr, n, c(received, lost)) %>%
  mutate(txt_pos = if_else(
    poz_utr == 'received',
    poz_pos,
    utr_pos
  )) %.>%
  ggplot(
    data = .,
    aes(
      x = województwo,
      y = n,
      color = poz_utr,
      label = n %>% fmt()
  )) +
  geom_segment(
    data = . %>% select(województwo, poz_utr, n) %>%
      spread(poz_utr, n),
    aes(
      xend = województwo,
      y = received,
      yend = lost,
      color = NULL,
      label = NULL
    ),
    color = 'grey'
  ) +
  geom_point() +
  geom_text(
    aes(y = txt_pos),
    size = roz_cz_txt,
    family = 'Calibri',
    show.legend = FALSE
  ) +
  theme(
    legend.title = element_blank(),
    legend.position = 'top',
    axis.text.x = element_blank()
  ) +
  scale_fill_manual(values = colors[c(10, 11)]) +
  ylim(c(-1100, 13000)) +
  coord_flip() +
  guides(fill = guide_legend(
    keywidth = leg_sq,
    keyheight = leg_sq,
    reverse = TRUE
  )) +
  scale_color_manual(values = colors[c(10, 11)])

Wordl map with arrows

wrld <- rgdal::readOGR('maps/TM_WORLD_BORDERS-0.3.shp', 'TM_WORLD_BORDERS-0.3')
## OGR data source with driver: ESRI Shapefile 
## Source: "D:\wd\my_ggplots\maps\TM_WORLD_BORDERS-0.3.shp", layer: "TM_WORLD_BORDERS-0.3"
## with 246 features
## It has 11 fields
## Integer64 fields read as strings:  POP2005
grat <-
  readOGR('maps/ne_110m_graticules_30.shp', 'ne_110m_graticules_30') %>%
  spTransform(CRS('+proj=robin')) %>%
  fortify()
## OGR data source with driver: ESRI Shapefile 
## Source: "D:\wd\my_ggplots\maps\ne_110m_graticules_30.shp", layer: "ne_110m_graticules_30"
## with 17 features
## It has 6 fields
## Integer64 fields read as strings:  recnum degrees scalerank
dane <- 
  data_list$map3 %>%
  mutate(bins = as.factor(bins))

wrld_center <-
  wrld %>%
  spTransform(CRS('+proj=robin')) %>%
  coordinates() %>%
  as_tibble() %>%
  set_names(c('long', 'lat')) %>%
  mutate(cntr_id = wrld@data$NAME) %>%
  left_join(dane, by = c('cntr_id' = 'dest')) %>%
  mutate(
    long_ = if_else(cntr_id == 'Poland', long, NA_real_),
    lat_ = if_else(cntr_id == 'Poland', lat, NA_real_),
    size = case_when(
      bins == levels(bins)[1] ~ .2,
      bins == levels(bins)[2] ~ .4,
      TRUE ~ .6)) %>%
  fill(long_, lat_, .direction = 'up') %>%
  fill(long_, lat_, .direction = 'down') %>%
  filter(!is.na(bins))

eur_center <-
  wrld %>%
  spTransform(CRS('+init=epsg:4326')) %>%
  coordinates() %>%
  as_tibble() %>%
  set_names(c('long', 'lat')) %>%
  mutate(
    cntr_id = wrld@data$NAME,
    long = case_when(
      cntr_id == 'Norway' ~ long - 4,
      cntr_id == 'Sweden' ~ long - 2,
      cntr_id == 'United Kingdom' ~ long + 1,
      TRUE ~ long
    ),
    lat = case_when(
      cntr_id == 'Norway' ~ lat - 3,
      cntr_id == 'Finland' ~ lat - 2,
      TRUE ~ lat
    )) %>%
  left_join(dane, by = c('cntr_id' = 'dest')) %>%
  mutate(
    long_ = if_else(cntr_id == 'Poland', long, NA_real_),
    lat_ = if_else(cntr_id == 'Poland', lat, NA_real_)
  ) %>%
  fill(long_, lat_, .direction = 'up') %>%
  fill(long_, lat_, .direction = 'down') %>%
  filter(!is.na(n)) %>%
  filter(long %>% between(-24, 36),
         lat %>% between(36, 67))

clean_map <- function(shp, proj, dane) {
  shp %>%
    spTransform(CRS(proj)) %>%
    rmapshaper::ms_simplify(keep = .1) %>%
    tidy(region = 'NAME') %>%
    left_join(
      dane %>% select(dest, n, bins),
      by = c('id' = 'dest')
    ) %>%
    mutate(clr = if_else(id == 'Poland', 0, n))
}

wrld_epg <-
  wrld %>%
  clean_map('+init=epsg:4326', dane)

wrld_rob <-
  wrld %>%
  clean_map('+proj=robin', dane)

wrld_rob %>%
  filter(lat > -6e6) %.>%
  ggplot(
    data = .,
    aes(
      x = long,
      y = lat
  )) +
  geom_path(
    data = grat,
    aes(group = group),
    linetype = 'dotted',
    color = 'steelblue',
    alpha = .3
  ) +
  geom_polygon(aes(
      group = group,
      fill = clr
    ),
    col = 'steelblue',
    size = .00001,
    show.legend = FALSE
  ) +
  geom_curve(
    data = wrld_center %>%
      filter(long >= 1567190),
    aes(
      x = long_,
      y = lat_,
      xend = long,
      yend = lat,
      size = bins,
      color = bins
    ),
    curvature = -.3,
    arrow = arrow(type = 'closed', angle = 20, length = unit(1, 'mm')),
    alpha = .8
  ) +
  geom_curve(
    data = wrld_center %>% filter(long < 1567190),
    aes(
      x = long_,
      y = lat_,
      xend = long,
      yend = lat,
      size = bins,
      color = bins
    ),
    curvature = .3,
    arrow = arrow(type = 'closed', angle = 20, length = unit(1, 'mm')),
    alpha = .8
  ) +
  theme_map() +
  theme(
    legend.position = c(.37, -.22),
    legend.title = element_blank(),
    legend.text = element_text(family = 'Calibri'),
    legend.text.align = 1,
    legend.margin = margin(0, 0, 0, 0)
  ) +
  scale_color_manual(values = colors[c(12, 15, 13, 14)]) +
  scale_fill_gradient(
    low = rgb(.9, .9, .9),
    high = colors[2],
    na.value = 'white'
  ) +
  scale_size_manual(
    values = c(.4, .7, .1, 1.1) %>% rev(),
    labels = c(' 1 - 100', ' 101 - 1000', ' 1001 - 5000', ' > 5000')
  ) +
  guides(size = guide_legend(
    override.aes = list(
      color = colors[c(12, 15, 13, 14)],
      size = c(1.1, .7, .4, .1) %>% rev())
  ),
  color = FALSE) +
  coord_equal() +
  theme(legend.text.align = 0) +
  annotation_custom(ggplotGrob(
    ggplot(
      data = subset(wrld_epg, long > -100),
      aes(
        x = long,
        y = lat
      )) +
      geom_polygon(aes(
          group = group,
          fill = clr
        ),
        col = 'steelblue',
        size = .00001,
        alpha  = .8
      ) +
      geom_segment(
        data = eur_center,
        aes(
          x = long_,
          y = lat_,
          xend = long,
          yend = lat,
          size = bins,
          color = bins
        ),
        arrow = arrow(type = 'closed', angle = 20, length = unit(1, 'mm')),
        alpha = .8
      ) +
      coord_map(
        xlim = c(-24, 36),
        ylim = c(36, 67)
      ) +
      theme_map() +
      theme(
        legend.position = 'none',
        panel.border = element_rect(color = 'steelblue', fill = NA),
        panel.background = element_rect(color = 'white'),
        plot.margin = margin(0, 0, 0, 0)
      ) +
      scale_color_manual(values = colors[c(12, 15, 13, 14)]) +
      scale_fill_gradient(
        low = rgb(.9, .9, .9),
        high = colors[2],
        na.value = 'white'
      ) +
      scale_size_manual(values = c(1.1, .7, .4, .1) %>% rev())),
    xmin = -2e6,
    xmax = 14e6,
    ymin = -14e6,
    ymax = -40e5
  )